 LST OFF,NOASYM,NOVSYM,NOGEN
 X65816
 XREFSLOT 1
 SEG $00
*
***********************************************************
*                                                         *
*          PRODOS 8 LOBOTOMIZED DISPATCHER ROUTINE        *
*                                                         *
*           COPYRIGHT APPLE COMPUTER, INC., 1983-86       *
*                                                         *
*                    ALL RIGHTS RESERVED                  *
*                                                         *
***********************************************************
*
 SBTL "DISPATCHER I" 
***********************************************************
*
*  DISPATCHER 1 - This code ORGs and operates at $1000 but
*    is resident in memory at $D100 in the Alt 4K bank of the
*    Language Card.  The QUIT call vectors to a routine high
*    in the MLI that moves DISPATCHER 1 down and jumps to it.
*    The move routine MUST remain somewhere between $E000-$F7FF.
*
*  NOTE: This entire routine MUST remain no larger than 3 pages.
*
***********************************************************
 ORG $1000 
 MSB ON
PROMPT EQU $FF
CV EQU $25
CH EQU $24
INFOCALL EQU $C4
SETPFXCALL EQU $C6
GETPFXCALL EQU $C7
OPENCALL EQU $C8
READCALL EQU $CA
CLOSECALL EQU $CC
EOFCALL EQU $D1
ERRNUM EQU $DE ;Applesoft ERRNUM but who cares?
PATH EQU $280 ;Second half of input buffer
*
line3 equ $600 ; 3rd line of screen (starting from 0).
*
ENTRY EQU $2000
MLI EQU $BF00
BITMAP EQU $BF58
PFIXPTR EQU $BF9A
KBD EQU $C000
STB EQU $C010
RAMIN EQU $C08B 
ROMIN EQU $C082
RAMIN2 EQU $C083
CLEOL EQU $FC9C ;Clear to End of Line 
settxt equ $fb39 ; Monitor routine to set 40 col window.
HOME EQU $FC58
RDKEY EQU $FD0C
COUT EQU $FDED
CROUT EQU $FD8E
BELL EQU $FF3A
*
* Monitor equates, soft switch equates for fix #55....
*
setvid equ $fe93 ; Puts COUT1 in CSW.
setnorm equ $fe84 ; Normal white text on black backround.
init equ $fb2f ; Text pg1;text mode;sets 40/80 col window.
setkbd equ $fe89 ; Does an IN#1.
clr80vid equ $c00c ; Disable 80 column hardware.
clraltchar equ $c00e ; Switch in primary character set.
clr80col equ $c000 ; Disable 80 column store.
*
*  Reset the Rev e soft switches
*
*********** See rev note #55 ****************
HEREIN equ *
 LDA ROMIN
* JSR $FE93 ;SETVID 
* JSR $FE89 ;SETNORM 
* STA $C00C ;80 col off 
* STA $C00F ;Alt chrset on 
* STA $C000 ;Main ram
 sta clr80vid ; Disable 80 column hardware.
 sta clraltchar ; Switch in primary char set.
 sta clr80col ; Disable 80 column store.
 jsr setnorm ; Normal white chars on black backround.
 jsr init ; Text pg1; text mode; set 40 col window.
 jsr setvid ; Does a PR#0 (puts COUT1 in CSW).
 jsr setkbd ; Does an IN#0 to set Basic input to kbd.
****************************************************
*
*  Clear the memory Bit Map
*
CLRMAP LDX #$17 ;Do all the bytes 
 LDA #1
 STA BITMAP,X ;Protect page $BF00 
 DEX
 LDA #$0 ;Clear the rest 
CLRLOOP STA BITMAP,X
 DEX
 BPL CLRLOOP
 LDA #$CF
 STA BITMAP ;Protect pages 0,1 & $400-$7FF (Screen)
START EQU *
*
***************** See Rev Note #39 *********************
*
* jsr settxt ; No longer necessary with fix #55...
********************************************************
 JSR HOME ; Clear the screen
 JSR CROUT
*
********************* Rev Note #55  *******************
*
 ldx #>msg0-msgstart ; Load offset to message into x...
******************************************************
*
 JSR PRNTLOOP
 LDA #3 ;Set CV to 3rd line 
 STA CV
 JSR CROUT ;  and col 1 
 JSR MLI ;Call the MLI (Remember, this code executes at $1000) 
 DFB GETPFXCALL
 DW PREFIX
 LDX PATH ;Get PREFIX length 
 LDA #0 ;Put a 0 at end of Prefix 
 STA PATH+1,X
*
******************* See Rev Note #69 *******************
*
 ldx path ; Get length byte back.
 beq nilpfx ; Branch if no prefix to display!!
********************************************************
*
********************* Rev Note #55  *******************
*
*LDA #0 ;Put a 0 at end of Prefix 
*STA PATH+1,X
*LDA #>PATH+1 ;Put the prefix address in print loop 
*STA LOOP+1 
*LDA #<PATH 
*STA LOOP+2
*JSR PRNTLOOP
m1 lda path,x ; Display prefix directly
 ora #$80 ; Set hi bit for NORMAL text.
 sta line3-1,x ; to the screen.
 dex ; Next....
 bne m1 ; Branch until prefix displayed.
******************************************************
*
******************* See Rev Note #69 *******************
*
nilpfx equ *
********************************************************
 LDX #0
 DEC CV ;
 JSR CROUT ;Put the cursor on the first char 
GETKEY JSR RDKEY ;Wait for keyboard input 
 CMP #$8D ;Is it CR? 
 BEQ GOTPFX ;Yes, and we accept what was entered 
 PHA ;No, save the char 
 JSR CLEOL ;Clear rest of line 
 PLA ;Get char back 
 CMP #$9B ;Is it ESC? 
 BEQ START ;Yes, start over again 
 CMP #$98 ;If it is CTRL-X, start over. 
RESTRT BEQ START ;(Used as an extended BEQ from PRMPT) 
 CMP #$89 ;Is it TAB? 
 BEQ BADKEY ;No good if it is! 
 CMP #$FF ;Delete? 
 BEQ X2 ;Branch if it is
 CMP #$88 ;Back Space?
 BNE NOTBS ;Branch if not 
X2 CPX #$0 ;If it is, are we at col 0? 
 BEQ *+5 ;If col 0, do nothing 
 DEC CH ; else move left 1 char 
 DEX  ; decrement char count, 
 JSR CLEOL ; clear rest of line 
 JMP GETKEY ;Go get another char 
NOTBS BCS MAYBE
BADKEY JSR BELL ;Ring the speaker (bell) if it isn't. 
 JMP GETKEY
MAYBE CMP #$DB ;Ok, is it below 'Z'? 
 BCC *+4 ;Branch if yes 
 AND #$DF ;If not, shift it up upper case 
 CMP #$AE ;Is it below '.'? 
 BCC BADKEY ;If yes, it ain't good! 
 CMP #$DB ;Is it above 'Z'? 
 BCS BADKEY ;If so, it also ain't good 
 CMP #$BA ;Is it below ':'? ('.' - '9' range) 
 BCC GOODKEY ;Yes, it's good! 
 CMP #$C1 ;If not, is it at or above 'A'? ('A' - 'Z') 
 BCC BADKEY ;No, reject it 
GOODKEY INX ;It's OK.  Hallelulah! 
 CPX #39 ;Were there more than 39 chars? 
 BCS RESTRT ;Yes, too many!  Go restart. 
 STA PATH,X ;No, save the lucky char 
 JSR COUT ;Print it 
 JMP GETKEY ;  and go get another. 
GOTPFX EQU *
 CPX #$0 ;OK, is our Prefix length (chars entered)=0? 
 BEQ PRMPT ;If yes, don't bother re-setting it 
 STX PATH ;Set prefix length 
 JSR MLI ;Call the MLI 
 DFB SETPFXCALL
 DW PREFIX
 BCC PRMPT ;If ok, go get Filename
 JSR BELL ;If not, ring Bell 
 LDA #0 ;  and try again 
BADPFX BEQ RESTRT ;Z flag must be set for extended Branch
PRMPT JSR HOME ;Clear the screen for application name 
PRMPT1 JSR CROUT ;Output a CR 
*
********************* Rev Note #55  *******************
*
 ldx #>msg-msgstart ; Load offset to message into x...
******************************************************
*
 JSR PRNTLOOP
retryrich LDA #3 ;Set CV to 3rd line 
 STA CV
 JSR CROUT ;  and col 1 
 LDX #0
*
********************* Rev Note #69  *******************
*
*LOOP1 LDA #PROMPT ;Our cursor char 
* JSR COUT ;Print it 
* DEC CH ;  and point to it so a typed 
* LDA KBD ;  character can replace it. 
*BPL *-3 ;(We'll wait here till a keypress.) 
* STA STB ;Hit the strobe 
loop1 equ *
 jsr rdkey
 CMP #$9B ;ESC
 BNE NOTESC 
 LDA CH
 BNE PRMPT
 BEQ BADPFX ;If ESC in col 0 go get PREFIX again  
NOTESC CMP #$98 ;CTRL-X
EXTNDBR BEQ PRMPT ;(Used as a branch extender) 
 CMP #$89 ;TAB
 BEQ NOTGUD
 CMP #$FF ;Delete?
 BEQ X3
 CMP #$88 ;BACK SPACE
 BNE X1
X3 JMP EATEM ;Eat the previous character. 
X1 BCS GETIN1 ;> $88 and the char may be acceptable 
NOTGUD JSR BELL ;Ring the bell (speaker) 
 JMP LOOP1
GETIN1 CMP #$8D ;Is it a CR?
 BEQ DONE
 CMP #$DB ;> than Z 
 BCC *+4 ;No. 
 AND #$DF ;Make sure its Upper case  
 CMP #$AE ;Is it "."?
 BCC NOTGUD ;Branch if less 
 CMP #$DB ;Must be less than "[". 
 BCS NOTGUD
 CMP #$BA ;OK if less than or equal to "9" 
 BCC ITSGUD
 CMP #$C1 ;Else must be > than "A" 
 BCC NOTGUD
ITSGUD EQU *
 PHA
 JSR CLEOL
 PLA
 JSR COUT ;No, print it 
 INX
 CPX #39
 BCS EXTNDBR 
 STA PATH,X 
 JMP LOOP1 ;Go get the next one 
DONE EQU *
 LDA #' '
 JSR COUT ;After the CR, blank out the cursor. 
 STX PATH ;Put the length in front of the name. 
*
*  At this point the specified Pathname is in PATH ($280)
*    and we can do a GET_FILE_INFO on it.
*
 JSR MLI
 DFB INFOCALL
 DW INFO
 BCC INFOOK
 JMP ERROR
INFOOK LDA TYPE
 CMP #$FF ;Is it a type SYS file?
 BEQ DOIT
 LDA #1 ;Not SYS File
 JMP ERROR
DOIT EQU * ;It's a type SYS all right! 
 LDA #0
 STA CLSNUM
 JSR MLI
 DFB CLOSECALL ;CLOSE all open files first
 DW CLS
 BCC CHKACS 
 JMP ERROR
*
*  Now check for the proper access
*
CHKACS LDA ACESS ;Get the allowed access 
 AND #1 ;Is READ disabled? 
 BNE ACSOK ;No. Access ok. 
 LDA #$27 ;I/O error 
 JMP ERROR ;Never returns! 
ACSOK EQU *
 JSR MLI
 DFB OPENCALL
 DW OPN ;OPEN it. 
 BCC *+5
 JMP ERROR
 LDA REFNUM
 STA REEDNUM ;Spread REFNUM around
 STA EOFNUM
*
*  Ok it's OPEN, let's get the EOF
*
 JSR MLI
 DFB EOFCALL
 DW EOF
 BCS ERROR
 LDA EOFB+2 ;3rd of 3 bytes 
 BEQ EOFOK
 LDA #$27 ;I/O ERROR even though the file is
 BNE ERROR ;  simply too large
EOFOK LDA EOFB ;Move EOF to Read # bytes
 STA RCOUNT
 LDA EOFB+1
 STA RCOUNT+1
 JSR MLI
 DFB READCALL ;Do the READ 
 DW REED
 PHP ;Push the processor status
 JSR MLI
 DFB CLOSECALL ;Close it 
 DW CLS
 BCC *+6 
 PLP ;Get status back (it is irrevalent now)
 BNE ERROR ;(if CLOSE generated an error)
 PLP ;We're here if CLOSE was OK
 BCS *-4 ;JMP ERROR
 JMP ENTRY 
*
EATEM EQU *
 LDA CH ;Is the cursor in col 0? 
 BEQ EATEMBAK ;Yes, ignore it. 
 DEX
 LDA #' '
 JSR COUT ;Blank out the cursor 
 DEC CH ;Point to last character 
 DEC CH ;  entered... 
 JSR COUT ;  and blank it too. 
 DEC CH ;Point to that location 
EATEMBAK JMP LOOP1 ;Go back & get the next char 
*
****************** See Rev Note #55  *****************
*
*PRNTLOOP LDX #0 ;Index into message
*LOOP LDA *,X ;CAUTION:  SELF-MODIFYING CODE 
* BEQ LOOPRTN ;  ADDR FILLED W/ LOC OF MESSAGE. 
* ORA #$80
* JSR COUT ;Print message on screen 
* INX 
* BNE LOOP ;Loop til done (rotisserie mode) 
*LOOPRTN RTS
*
prntloop equ *
 lda msgstart,x ; Display string; offset is in X.
 beq done1 ; Branch if done.
 jsr cout ; Output character...
 inx  ; Next..
 bne prntloop ; Branch always.
done1 rts  ; Done.
****************************************************
ERROR EQU *
 STA ERRNUM
 LDA #$0C ;Put error message on line 13 
 STA CV
 JSR CROUT
 LDA ERRNUM
 CMP #1
 BNE NEXTERR
*
*************** See Rev Note #55  **************
*
* LDA #>ERR1 
* STA LOOP+1 
* LDA #<ERR1 
* STA LOOP+2 
*
 ldx #>err1-msgstart ; Load x with offset to message.
***********************************************
 BNE DOERROR
NEXTERR CMP #$40 
 BEQ ERROR3 
 CMP #$44  
 BEQ ERROR3
 CMP #$45 
 BEQ ERROR3
 CMP #$46 
 BEQ ERROR3
*
*************** See Rev Note #55  **************
*
* LDA #>ERR2
* STA LOOP+1 
* LDA #<ERR2
* STA LOOP+2 
 ldx #>err2-msgstart ; Load x with offset to message.
***********************************************
 BNE DOERROR
*
*************** See Rev Note #55  **************
*
*ERROR3 LDA #>ERR3
* STA LOOP+1
* LDA #<ERR3
* STA LOOP+2
error3 equ *
 ldx #>err3-msgstart ; Load x with offset to message.
***********************************************
DOERROR JSR PRNTLOOP
*
********************* Rev Note #69  *******************
*
* LDA #0 ; Printloop will leave A=0...See Rev Note #39
*STA CV
 JMP retryrich
*
***********************************************************
msgstart equ *
 MSB ON
MSG0 ASC 'ENTER PREFIX (PRESS "RETURN" TO ACCEPT)'
 DFB 0
MSG ASC "ENTER PATHNAME OF NEXT APPLICATION" 
 DFB 0 
ERR1 DFB $87 ;BELL
 ASC 'NOT A TYPE "SYS" FILE'
 DFB 0
ERR2 DFB $87
 ASC 'I/O ERROR            ' 
 DFB 0 
ERR3 DFB $87
 ASC 'FILE/PATH NOT FOUND  ' 
 DFB 0
*
***********************************************************
*
INFO DFB $A ;10 PARAMETERS ON GFI
 DW PATH ;Pathname buffer pointer
ACESS DFB 0 ;ACCESS
TYPE DFB 0 ;File Type
 DS $0D,0 ;All the rest are unimportant
*
OPN DFB 3 ;3 parameters on an OPEN
 DW PATH
 DW $1800 ;FCB Buffer
REFNUM DFB 0
*
CLS DFB 1
CLSNUM DFB 0 ;REFERENCE #
*
REED DFB 4 ;4 Parameters for a READ
REEDNUM DFB 0
 DW ENTRY ;SYS files always load at $2000
RCOUNT DW 0
 DW 0
*
EOF DFB 2
EOFNUM DFB 0
EOFB DS 3,0 ;Three byte EOF
*
PREFIX DFB 1
PBUF DW PATH 
*
ZZSIZ EQU *-HEREIN 
ZZFRE EQU $2FF-ZZSIZ
*
